' Generic utility routines that can be used anywhere.
' The routines in this files are language independent.
'
' HISTORY
' Aug-2005		GenoPro			Creation
' Sep 2005 - Apr 2008	Ron			Development & Maintenace


'===========================================================
' Initialize the global variables required to display individuals, families and pictures
' Those global variables begin by "g_" and are used by the routines found in multiple files.
' The global object g_collFootnotes is used to maintain a list of unique footnotes
' to be displayed at the bottom of the page
Dim g_collFootnotes, g_UID         ', g_NameTags

    g_UID = 0
    ' g_NameTags = Session("NameTags")	'Array of tag names for Name with item 0=Full, 1=Formal, 2=KnownAs 3=Short

	' Create an empty collection to keep all the footnotes on the generated page
	Set g_collFootnotes = Util.NewGenoCollection()

' following 2 functions are to simplify changes when GenoPro supports boolean Custom Tags
Function IsTrue(YorN)
	Select Case VarType(YorN)
	Case 11		' boolean
		IsTrue = YorN
	Case Else	' string etc.
		IsTrue = Left(UCase(YorN) & " ", 1) <> "N"
	End Select
End Function

Function IsFalse(YorN)
	Select Case VarType(YorN)
	Case 11		' boolean
		IsFalse = YorN
	Case Else	' string etc.
		IsFalse = Left(UCase(YorN) & " ", 1) <> "Y"
	End Select
End Function

Function ConfigMessage(strKey)
    ConfigMessage = ConfigMsg(strKey, "", "")
End Function

Function ConfigMsg(strKey, strDefault, strVersion)
	Dim oCfg, oNode, strPhrase
	Set oCfg = Session("ConfigMessages")
	If Util.IsNothing(oCfg) Then
		ConfigMsg = Dic(strKey)
	Else
		Set oNode = oCfg.selectSingleNode(strKey)
		If Util.IsNothing(oNode) Then
			If strDefault <> "" Then
				Set oNode = oCfg.selectSingleNode("WarningTagChange")
				If Util.IsNothing(oNode) Then
				    strPhrase= "Warning: tag {0} introduced at version {2} is missing from Config.xml so defaulted to {1}"
			    Else strPhrase=StrNormalizeSpace(oNode.getAttribute("T"))
			    End If
			    Report.LogWarning Util.FormatPhrase(strPhrase, strKey, strDefault, strVersion)
			Else
		        Set oNode = oCfg.selectSingleNode("ErrorConfigMessageNotFound")
			    If Not Util.IsNothing(oNode) Then Report.LogError StrNormalizeSpace(oNode.getAttribute("T")) & ": " & strKey
			End If
			ConfigMsg = strDefault
		Else
			ConfigMsg = StrNormalizeSpace(oNode.getAttribute("T"))
		End If
	End If
End Function

' initialise patterns for GetCoord Function (see below)
    Dim g_RegExp1, g_RegExp2
    Set g_RegExp1 = New RegExp
    g_RegExp1.Pattern = "[WSws]"
    Set g_RegExp2 = New RegExp
    g_RegExp2.Pattern = "[^\d\.]"
    g_RegExp2.Global = True

	Function GetCoord(strCoord)
	' normalize grid coordinate to a signed decimal e.g. for sorting
	dim coord, i,dec,negate,multiplier, strLocale
	strLocale = GetLocale()
	SetLocale("en-gb")
	If (strCoord <> "") Then
		dec=0: negate = 1: multiplier = 1
		coord = g_RegExp1.Replace(strCoord, "-") ' change W or S to -
		If InStr(coord,"-") > 0 Then negate = -1
		coord = g_RegExp2.Replace(coord," ") ' change any other non decimal to space
		coord=Split(coord," ")
		For i=0 to UBound(coord)
			If coord(i) <> "" Then
			   If Isnumeric(coord(i)) Then
  				 dec = dec + coord(i) * multiplier
  				 multiplier = multiplier / 60
 				 Else
 				   Report.LogError ConfigMsg("ErrorLatLang", "Error: Unknown Latitude/Longitude format: " , "2011.01.07") & strCoord
 				   Exit For
	       End If
			End If
		Next
		GetCoord = dec * negate
	Else
		GetCoord = ""
	End If
	SetLocale(strLocale)
	End Function

Function GetFileTimestamp(strPath)
	' get 'date last modified' of a picture and convet to timestamp
	' N.B. requires objects oHttp and oFso to be initialised and available
	Dim strPictureDate, strLocale
	strLocale = GetLocale
	SetLocale("en-gb")	'level playing field for date conversion
	Err.Clear
	On Error Resume Next
	If LCase(Left(strPath,5)) = "http:" Then
		oHttp.Open "HEAD", strPath, False
		oHttp.Send
		On Error Goto 0
		If Err.Number = 0 Then strPictureDate = oHttp.getResponseHeader("Last-Modified")
		If Err.Number <> 0 Or strPictureDate = "" Then
			Report.LogError Util.FormatString(ConfigMessage("ErrorFetchHeader"), strPath) & _
				Util.IfElse(Err.Number > 0, "(Error " & (Err.Number And (256*256-1)) & " " & Err.Description & ")", "")
			GetFileTimeStamp=""
		Else	' convert date & time to timestamp (100s of nanoseconds since 01/01/1601 !!!
			GetFileTimestamp = HexTimestamp(Mid(strPictureDate,6,20))
			If Err.Number <> 0 Then
				Report.LogError Util.FormatString(ConfigMessage("ErrorVB"), (Err.Number And (256*256-1)), Err.Description, strPath)
				GetFileTimeStamp=""
			End If
		End If
	Else
		GetFileTimestamp = HexTimestamp(oFso.GetFile(strPath).DateLastModified)
		If Err.Number <> 0 Then
			Report.LogError Util.FormatString(ConfigMessage("ErrorVB"), (Err.Number And (256*256-1)), Err.Description, strPath)
			GetFileTimeStamp=""
		End If
	End If
	SetLocale(strLocale)
End Function

	Sub GMapAddPlace(oPlaces, oParent, oEvent, oStart, oEnd, strType, strText)
	    Dim cnt, idx, oEvents, oDate, strName, strEnd
    	If oEvent.Place.Latitude <> "" And oEvent.Place.Longitude <> "" Then
   	      cnt=oPlaces.Count
   	      idx = oPlaces.AddUnique(oEvent.Place)
   	      If oPlaces.Count > cnt Then
             oEvent.Place.Session("events") = Util.NewStringDictionary()
          End If
          Set oEvents=oEvent.Place.Session("events")
     	    If Util.IsNothing(oEnd) Then
     	        Set oDate=oStart
     	        strEnd=""
          Else
              Set oDate=Util.IfElse(Util.IsNothing(oStart),oEnd, oStart)
              strEnd=oEnd.ToString
          End If
          strName=Util.IfElse(Util.IsNothing(oParent),"", oParent)
          oEvents.Add Util.FormatPhrase("{0} {1} {2}: {3}[ {4}][->{5}]", oDate.Year, strName, strType, strText, oStart.ToString, strEnd), GetDate(oDate)
 	    End If
	End Sub

Sub GMapCollateFamilyEvents(oPlaces, f, NameReqd)
    Dim e, oFam
  	If NameReqd Then Set oFam = f Else Set oFam = Nothing End If
  	For Each e In f.Unions
  	    GMapAddPlace oPlaces, oFam, e, e.Date, Nothing, Util.IfElse(e.Type.ID = "", Dic("Marriage"), e.Type), ""
  	    GMapAddPlace oPlaces, oFam, e.Divorce, e.Divorce.Date, Nothing, StrDicExt("Divorce","","Divorce/Separation","","2010.12.10"), ""
    Next
End Sub

Sub GMapCollateIndividualEvents(oPlaces, i, NameReqd)
    Dim e, oInd
  	If NameReqd Then Set oInd = i Else Set oInd = Nothing End If
  	GMapAddPlace oPlaces, oInd, i.Birth, i.Birth.Date, Nothing, Dic("Birth"), ""
  	GMapAddPlace oPlaces, oInd, i.Birth.Baptism, i.Birth.Baptism.Date, Nothing, "Baptism", ""
  	GMapAddPlace oPlaces, oInd, i.Death, i.Death.Date, Nothing, Dic("Death"), ""
  	GMapAddPlace oPlaces, oInd, i.Death.Funerals, i.Death.Funerals.Date, Nothing, Dic("Funeral"), ""
  	GMapAddPlace oPlaces, oInd, i.Death.Disposition, i.Death.Disposition.Date, Nothing, StrDicExt("Disposition", "", "Body disposition", "", "2010.12.10"), ""
  	For Each e In i.Contacts
  	    GMapAddPlace oPlaces, oInd, e, e.DateStart, e.DateEnd, Util.IfElse(e.Type.ID = "", Dic("Occupancy"), e.Type), ""
    Next
  	For Each e In i.Educations
  	    GMapAddPlace oPlaces, oInd, e, e.DateStart, e.DateEnd, Dic("Education"), Util.FormatPhrase("{0}[ {1}][ {2}]", e.Institution, e.Level, e.Program)
    Next
  	For Each e In i.Occupations
  	    GMapAddPlace oPlaces, oInd, e, e.DateStart, e.DateEnd, Dic("Occupation"), Util.FormatPhrase("{0}[ ({1})][ {2}]", e.Title, e.WorkType, e.Company)
    Next
End Sub

Sub GMapWriteEvents(oPlaces)
' Write Google Map Marker data to output buffer
    Dim oCoord, oCoords, oCnt, oEvents, e, p, strPlaces, strSep, strSep2
    ' amalgamate places at same coords for one pin on map
    Set oCoords = Util.NewObjectRepertory()
    For Each p in oPlaces
        oCoords.Add GetCoord(p.Latitude) &"/" & GetCoord(p.Longitude), p
    Next
    Report.WriteLn "var gMapData = {markers: ["
  	strSep = ""
    For Each oCoord in oCoords
        cCnt = 0
      	For Each p In oCoord
      	    cCnt = cCnt + p.Session("events").Count
      	Next
        strSep2="": strPlaces=""
      	Report.Write strSep & "{"
 			  Report.WriteFormatted """lat"": ""{&j}"", ""lng"": ""{&j}"", ""html"":""<div class='infoWindow{}'>", oCoord.Object(0).Latitude, oCoord.Object(0).Longitude, Util.IfElse(cCnt+oCoord.Count>10," infoScroll","")
      	For Each p In oCoord
       	    Set oEvents=p.Session("events")
      	    oEvents.SortByValue() ' date order
      			Report.WriteFormattedBr "<b>{&j}</b>", JoinPlaceNames(p, p.Name, true), Util.IfElse(oEvents.Count>10," infoScroll","")
            For e=0 To oEvents.Count-1
                Report.WriteBr oEvents.Key(e)
            Next
            strPlaces = strPlaces & strSep2 & JoinPlaceNames(p, p.Name, true)
            strSep2 = "; "
            Set oEvents = Nothing
      	Next
  			Report.WriteFormattedLn "</div>"",""label"":""{&j} ({})""", strPlaces, Dic.PlurialCount("Reference",cCnt)
  			Report.WriteLn "}"
        strSep=","
   	Next
    Report.WriteLn "]}"
End Sub
Function HexTimestamp(strDate)
' Convert date & time to timestamp (hexadecimal string representing 'hundreds of nanoseconds' since 1st Jan 1601
	Dim n1,n2,n3, n3a, n3b
	n1 = CDbl(0)
	n1 = n1 + DateDiff("s", #1/1/1601#, DateValue(strDate)) + (Hour(strDate) * 60 + Minute(strDate)) * 60 + Second(strDate)' timestamp in seconds since 01/01/1601
	n2  = n1 / 2^32 * 10000000	' MS 32 bits of "hundreds of nanoseconds"
	n3 = (n2 - Int(n2)) * 2^32	' LS 32 bits
	n3a = Int(n3 / 2^16)
	n4a = (n3 - n3a) * 2^16
	HexTimestamp = Right("00000000" & Hex(n2),8) & Right("0000" & hex(n3a), 4) & Right("0000" & hex(n3b), 4)
End Function


Sub WriteHtmlButtonToggle(style)
	Select Case style
	Case "Notes"
		Report.WriteFormattedLn "<img src='images/{}.gif' class='toggle24' name='toggle' onclick='javascript:ToggleTree(this.name,"""");' alt='{1} {2}' title='{1} {2}'/>", Util.IfElse(Session("fCollapseNotes"),"expand","collapse"), Dic("TocExpandCollapseAll"), Dic(style)
	Case "References", "OtherDetails"
		Report.WriteFormattedLn "<img src='images/{}2.gif' class='toggle24' name='toggle2' onclick='javascript:ToggleTree(this.name,""2"");' alt='{1} {2}' title='{1} {2}'/>", Util.IfElse(Session("fCollapseReferences"),"expand","collapse"), Dic("TocExpandCollapseAll"), Dic(style)
	Case "Entries"
    Report.WriteFormattedLn "<div class='floatright buttontoc'><img name='tocStateButton' onclick='tocToggle();' class='control24' src='images/blank.gif' alt='' title='' style='margin-right:3px;'/><img class='control24' src='images/close.gif' alt='{}' title='{0}' onclick='javascript:tocHide();' /></div>", StrDicExt("AltCloseIndex", "", "Close this index", "", "2.0.1.7")
		Report.WriteFormattedLn "<div class='buttontoc'><img src='images/{}2.gif' class='toggle24' name='toggle2' onclick='javascript:ToggleTree(this.name,""2"");' alt='{1} {2}' title='{1} {2}'/></div>", Util.IfElse(fTreeOpen,"collapse","expand"), Dic("TocExpandCollapseAll"), Dic(style)
	Case "HidePopUp"  ' close 'popup' frame
		Report.WriteFormattedLn "<img src='images/close.gif' class='control24' onclick='javascript:hidePopUpFrame(event);' alt='{0}' title='{0}'/>", Dic("AltHidePopUpFrame")
	End Select
End Sub

' Write the HTML code to display all the pictures of an individual, family or place
Sub WriteHtmlPictures(i, cxWidthMax, cyHeightLimit, cxyPadding, strAlign, strHeading, fNoName)
	Dim p, pic, fExclude, pic1, pCnt
	pCnt = 0
	Set pic1 = i.Pictures.Primary	' Get the primary picture of the individual or family
	If Not Util.IsNothing(pic1) Then If pic1.PictureDimension = "" Or pic1.Session("IsExcluded") Then Set pic1 = Nothing
'	find first non-excluded, count of non-excluded & tallest
	For Each pic in i.Pictures
		If Not pic.Session("IsExcluded") And pic.PictureDimension <> "" Then
			strDimension = pic.PictureDimension(cxWidthMax & "x" & cyHeightLimit)
			cyHeight = Util.GetHeight(strDimension)
			If cyHeight > cyHeightMax Then cyHeightMax = cyHeight
			pCnt = pCnt + 1
			If pic1 Is Nothing Then Set pic1 = pic
		End If
	Next
	' Get the dimension of the picture.  This will load the picture if not already loaded
	If pCnt > 0 Then
		Dim strId, strDimension,  cyHeightMax, cyHeight
		i.Session("PictureMain") = pic1
		strId = i.ID
		Report.WriteFormattedLn "{}<div id='idPVp_{}'>", strHeading, strId
		WriteHtmlPicture pic1, cxWidthMax, cyHeightMax, cxyPadding, strAlign, cxWidthMax, cyHeightLimit
		Report.Write "</div>"
		WriteHtmlNamePicture i, pic1

		If (pCnt > 1) Then
			' Generate the code to create a slide show of pictures
			WriteHtmlButtonPV strId, "Play"
			WriteHtmlButtonPV strId, "Pause"
			WriteHtmlButtonPV strId, "Prev"
			WriteHtmlButtonPV strId, "Next"
			Report.WriteFormattedLn "<img id='idPVslider_{2}' src='images/slider.gif' style='position:relative;' width='30' height='16' alt='{0&t}' title='{0&t}'/>" & _
					"<img onmousemove='sliderMouseMove(event);' onmousedown='sliderMouseDown(event);' onmouseout='sliderMouseUpOut(event);' onmouseup='sliderMouseUpOut(event);' " & _
						"style='position:relative;left:{1}px;' src='images/knob.gif' width='9' height='15' alt='{0&t}' title='{0&t}'/>", Dic("PV_Speed"), Session("PictureInterval"), strId
			Report.WriteFormattedLn "<select class='hide' id='idPVs_{0}' onchange=""PV_PickCore('{0}', 0);"">", strId
			For Each pic In i.Pictures
				If Not pic.Session("IsExcluded") Then
					Dim strImg, strSelected
					strImg = StrHtmlPicture(pic, cxWidthMax, cyHeightMax, cxyPadding, strAlign, cxWidthMax, cyHeightLimit)
					strSelected = Util.IfElse(pic.ID <> pic1.ID, "", " selected=""selected""")
					If Session("fShowPictureDetails") Then
						Report.WriteFormattedLn "<option{0} class='hide' value='{1&t}{5&t}{2&t}{5&t}{3&t}{5&t}{4&t}' ></option>", _
							strSelected, _
              strImg, _
              Util.IfElse(fNoName, StrHtmlHyperlink(pic), ""), _
              Util.HtmlEncode(LanguageDictionary.FormatPhrase("PhPictureDetails", _
                Util.IfElse(fNoName, "", StrHtmlTag(Trim(StrFormatText(pic,StrParseText(pic.Name, True))),"strong")), _
                pic.Date.ToStringNarrative, _
                pic.Place.Session("HlinkLocative"), _
                pic.Source.Session("Hlink"))), _
              StrParseText(pic.Description, True), _
              chr(31)
					Else
						Report.WriteFormattedLn "<option{0} class='hide' value='{1&t}{3&t}{2&t}' ></option>", _
							strSelected, strImg, StrHtmlHyperlink(pic), chr(31)
					End If
				End If
			Next
			Report.WriteBr "</select>"
		End If
	End If
End Sub

Sub WriteHtmlPicturesLarge(i, strAlign, strHeading, fNoName)
	WriteHtmlPictures i, Session("cxPictureSizeLarge"), Session("cyPictureSizeLarge"), Session("cxyPicturePadding"), strAlign, strHeading, fNoName
End Sub

Sub WriteHtmlPicturesSmall(i, strAlign, fNoName)
	WriteHtmlPictures i, Session("cxPictureSizeSmall"), Session("cyPictureSizeSmall"), Session("cxyPicturePadding"), strAlign, "", fNoName
End Sub

Sub WriteHtmlPictureSmall(p, strAlign)
	WriteHtmlPicture p, Session("cxPictureSizeSmall"), Session("cyPictureSizeSmall"), Session("cxyPicturePadding"), strAlign, Session("cxPictureSizeSmall"), Session("cyPictureSizeSmall")
End Sub

Sub WriteHtmlPicture(p, cxWidthMax, cyHeightMax, cxyPadding, strAlign, cxWidthLimit, cyHeightLimit)
	Dim strDimension, cxWidth, cyHeight, cxMargin, cyMargin, cxMarginL, cxMarginR, strAttributesHTML, strFloat, strThumbnail, i, strAreaMap, strExt, strPath

	If Not p.Session("IsExcluded") Then
		strPath = p.Path.Report
        If (Session("BasePath") <> "" And Instr(strPath, Session("BasePath")) = 8) Then strPath = "..\.." & Mid(strPath, 8+Len(Session("BasePath")))
		strThumbnail = strPath
		If Session("fUsePictureThumbnails") Then
			strThumbnail = p.Session("Thumbnail")
		End If
		strDimension = p.PictureDimension(cxWidthMax & "x" & cyHeightMax)
		cxWidth = Util.GetWidth(strDimension)
		cyHeight = Util.GetHeight(strDimension)

		cxMargin = (cxWidthMax - cxWidth) \ 2
		If (cxMargin < 0) Then cxMargin = 0
		cyMargin = (cyHeightMax - cyHeight) \ 2
		If (cyMargin < 0) Then cyMargin = 0
		strFloat=""
		cxMarginL = cxMargin
		If (strAlign = "right") Then cxMarginL = cxMarginL + cxyPadding
		cxMarginR = cxMargin
		If (strAlign = "left") Then
			cxMarginR = cxMarginR + cxyPadding
		End If
		strAttributesHTML = Util.FormatString(" width='{}px' height='{}px' class='pic{}' style='margin:{}px {}px {}px {}px;'", cxWidth, cyHeight, strAlign, cyMargin, cxMarginR, cyMargin, cxMarginL)
		strAreaMap = CustomTag(p, "_AreaMap")
		If strAreaMap = "" Then
			Report.WriteFormattedLn "<img src='{}'{} onclick='viewPic(""{&j}"")' alt='{&t}' title='{3&t}'/>", strThumbnail, strAttributesHTML, strPath, Util.FormatPhrase(Dic("PhPictureTooltip"), "", p.Date.ToStringNarrative, p.Place.Session("Locative"), StrParseText(p.Source, True))
		Else
			Report.WriteFormattedLn "<a href='picture-{}.htm' onclick='javascript:showPopUpFrame("""");' target='popup' title='{&t}'><img src='{}'{} title='{1&t}' alt='{&t}'/></a>", p.ID, Dic("PictureDetailsTip"), strThumbnail, strAttributesHTML, Util.FormatPhrase(Dic("PhPictureTooltip"), "", p.Date.ToStringNarrative, p.Place.Session("Locative"), StrParseText(p.Source, True))
		End If
	End If
End Sub

Sub WriteHtmlNamePicture(o, p)
	Dim strId
	strId = o.ID
	If Not (Session("fHidePictureName") Or p.Session("IsExcluded")) Then
		Report.WriteFormattedLn "<div class='caption' id='idPVn_{}'>{}</div>", strId, StrHtmlHyperlink(p)
	End If
End Sub

Function StrFullDate(xDate)

' Make a complete date (dd mmm yyyy) from a either a GenoDate object or a (partial) date string by adding month (Jan) and/or day (01)

Dim strMonth, oDate, nMonth, nDay, strDate, nDate, strEra

If IsObject(xDate) Then
'	On Error Resume Next
'	If IsObject(xDate.Date) Then
'     Set oDate = CustomDate(xDate.Date)	' check if parent of Date object
'  ElseIf IsObject(xDate) Then
      Set oDate = CustomDate(xDate)
''  Else
''      Set oDate = xDate
''  End If
        Err.Clear
	strDate = Replace(oDate.ToString(""),"th,","")
	On Error Goto 0
	strDate = Replace(strDate,"st,","")
	strDate = Replace(strDate,"nd,","")
	strDate = Replace(strDate,"rd,","")

	If IsDate(strDate) Then
		nDate = CDate(strDate)
		StrFullDate = Day(nDate) & " " & MonthName(Month(nDate), True) & " " & Year(nDate)
		Exit Function
	End If
	On Error Resume Next
	strEra = " " & oDate.Era
	If Err.Number > 0 Then strEra = ""
	On Error Goto 0
	If oDate.Year <> "" And strEra = "" Then
		nMonth = oDate.NMonth
		If IsNumeric(nMonth) Then
			If nMonth > 0 And nMonth < 13 Then
				strMonth = MonthName(nMonth, True)
			Else
				strMonth = MonthName(1, True)
			End If
		Else
			strMonth = MonthName(1, True)
		End If
		nDay = oDate.NDay
		If IsNumeric(nDay) Then
			strDate = Util.IfElse(nDay > 0 And nDay < 32, nDay, "01") & " " & strMonth & " " & oDate.Year
			StrFullDate = Util.IfElse(IsDate(strDate), strDate, "")
		Else
			strDate = "01 " & strMonth & " " & oDate.Year
			StrFullDate = Util.IfElse(IsDate(strDate), strDate, "")
		End If
	ElseIf oDate.Year <> "" Then
	       StrFullDate = oDate.Year
	Else
		StrFullDate = ""
	End If
Else
	StrFullDate = ""
End If
End Function

Function StrGnoDate(xDate, fYearOnly)
Dim oDate

If IsObject(xDate) Then
	Set oDate = xDate
	On Error Resume Next
	If IsObject(xDate.Date) Then Set oDate = xDate.Date	' check if parent of Date object
        Err.Clear
	On Error Goto 0
	If fYearOnly Then
		StrGnoDate = oDate.ToString("[|~|<|>]yyyy")
	Else
		StrGnoDate = oDate.Approximation & Trim(oDate.ToString("dd MMM yyyy"))
	End If
Else
	StrGnoDate = ""
End If

End Function

' Output Html Content-Language e.g. "en-us" "fr" etc.
Sub WriteHtmlLang()
	Report.Write Session("HtmlLang")
End Sub

Sub WriteHtmlExtraNarrative(obj)
	Dim strNarrative
	strNarrative = CustomTag(obj, "_Narrative")
	If strNarrative <> "" Then
		Report.WriteFormattedLn "<div>{}</div>", StrFormatText(obj, StrParseText(strNarrative, True))
	End If
End Sub

' Same as WriteHtmlPicture() however returns a string containing the HTML code from what should be written to the output buffer
Function StrHtmlPicture(p, cxWidthMax, cyHeightMax, cxyPadding, strAlign, cxWidthLimit, cyHeightLimit)
	Dim cchBuffer
	cchBuffer = Report.BufferLength
	WriteHtmlPicture p, cxWidthMax, cyHeightMax, cxyPadding, strAlign, cxWidthLimit, cyHeightLimit
  Report.BufferLength = Report.BufferLength -2
	StrHtmlPicture = Report.Buffer(cchBuffer)	' Get the text from the output buffer
	Report.BufferLength = cchBuffer	' Truncate the buffer to its original length
End Function


' Write the HTML code to generate a button (Play, Pause, Next, Prev) of the Picture Viewer (PV).
Sub WriteHtmlButtonPV(strId, strVerb)
	Report.WriteFormattedLn "<a href=""JavaScript:PV_{1}('{0}');"" {2}><img src='images/PV_{1}.gif' border='0' alt='{3&t}' title='{3&t}'/></a>", strId, strVerb, StrMouseOver(Dic("PV_" & strVerb)), Dic("PV_" & strVerb)
End Sub


' Return a string containing the HTML code to display the gender of the individual.
Function StrHtmlImgGender(i)
	StrHtmlImgGender = Util.FormatString("<img src='images/gender_{}.gif' class='icon' alt='{&t}' title='{1&t}' />&nbsp;", i.Gender.Id, i.Gender)
End Function

Function StrHtmlImgFamily(f)
	Dim strGender0, strGenders
	strGenders = "MF"
	strGender0 = f.Parents(0).Gender.ID
	If (strGender0 = f.Parents(1).Gender.ID) Then
		' Same-sex couples
		Select Case strGender0
			Case "M"
				strGenders = "MM"
			case "F"
				strGenders = "FF"
		End Select
	End If
	' strGenders = ""	' Enable this line if you want a generic icon for a family
	StrHtmlImgFamily = Util.FormatString("<img src='images/family_{}.gif' class='icon' alt='{}' title='{1}'/> ", strGenders, Dic("Family"))
End Function

Function StrHtmlImgPhoto(obj)
	Select Case obj.Class
	Case "Picture"
		If Not obj.Session("IsExcluded") Then
			StrHtmlImgPhoto = Util.FormatString("<img src='images/space.gif' width='16' alt=''/>&nbsp;<a href='pictures.htm#{}'><img src='images/photo.gif' class='icon' alt='' title='' />&nbsp;{}</a>", _
				obj.ID, Util.IfElse(Trim(obj.Name) <> "", StrFormatText(obj, StrParseText(Trim(obj.Name), True)), "(" & obj.ID &")"))
		End If
	Case Else
		cPictures = obj.Session("PicturesIncluded")
		If (cPictures > 0) Then
			StrHtmlImgPhoto = Util.FormatString("&nbsp;<a href='{}'><img src='images/photo.gif' class='icon' alt='{}' title='{1}' /></a>", _
				obj.Href, Dic.PlurialCount("Picture", cPictures))
		End If
	End Select
End Function

Function StrHtmlImgPhotoLink(i, target)
	cPictures = i.Session("PicturesIncluded")
	If (cPictures > 0) Then
		StrHtmlImgPhotoLink = Util.FormatString("&nbsp;<a href='{}#{}'><img src='images/photo.gif' class='icon' alt='{}' title='{2}' /></a>", _
			target, i.ID, Dic.PlurialCount("Picture", cPictures))
	End If
End Function

' Link to the .gno file if present in the report
Function StrHtmlImgFileGno(obj)
	Dim strName
	strFileFamilyTreeGno = ReportGenerator.ExtraFiles("FamilyTree.gno")
	If (strFileFamilyTreeGno <> "") Then
		If obj.Class="Individual" Then
			strName = obj.Session("NameFull")
		Else
			strName = obj.Name
		End If
		StrHtmlImgFileGno = Util.FormatString(" <a href='{}?id={}'><img src='images/gno.gif' class='icon' alt='{&t}' title='{2&t}'/> </a> ", strFileFamilyTreeGno, obj.Id, Dic.FormatString("FmtAltViewInGnoFile", strName))
	End If
End Function

Function StrHtmlImgMap(o)
  If o.Session("gMap") = True Then ' i.e. there are some geo-tagged PLaces for this individual/family
     Dim strAlt
     strAlt=StrDicExt("AltgMap" & o.Class, "", "Display a Google Map showing geo-tagged places associated with this " & Dic(o.Class),"", "2010.12.10")
     StrHtmlImgMap = Util.FormatString(" <a href='gmap.htm?id={},classId={},name={}' target='popup'><img src='images/pin.gif' class='icon' alt='{&t}' title='{3&t}'/> </a> ", o.ID, o.Class, Replace(Util.UrlEncode(o),"+","%20"), strAlt) 'ShowPopup removed from google map initiation code, to allow map of all people to appear in _detail
  End If
End Function

Function StrHtmlImgFileSvg(obj)
	Dim fFlag, strFileGenoMap, xyTopRight, xyTopLeft, xyStartRight, xyStartLeft, xTopCenter, pos
	fFlag = ReportGenerator.NegateAxisY
	ReportGenerator.NegateAxisY = True
	strFileGenoMap = obj.Position.GenoMap.Session("PathGenoMap")
	If ((Session("Svg") or Session("Pdf")) And strFileGenoMap <> "") Then
		Select Case obj.Class
		Case "Individual"
			StrHtmlImgFileSvg = Util.FormatString(" <a href='{}?x={},y={},highlight=true,toggle={},name={}' target='popup'><img src='images/svg.gif' class='icon' alt='{&t}' title='{4&t}'/> </a> ", strFileGenoMap, obj.Position.x, obj.Position.y, Util.IfElse(Session("SvgDefault"), "SVG", "PDF"), obj.ID, Dic.FormatString("FmtAltViewInSvgFile", obj.Name))
		Case "Family"
			Set pos = obj.Position
			xyTopRight=split(pos.Top.Right,",")
			xyTopLeft=split(pos.Top.Left,",")
			xyStartRight=split(pos.Bottom.Right,",")
			xTopCenter=xyTopLeft(0)+ ( xyTopRight(0) - xyTopLeft(0) ) / 2
			If uBound(xyStartRight) > 0 Then	' bottom line present, so centre highlight on top of vertical line
				StrHtmlImgFileSvg = Util.FormatString(" <a href='{}?x={},y={},highlight=true, toggle={}, name={}' target='popup'><img src='images/svg.gif' class='icon' alt='{&t}' title='{4&t}' /> </a> ", strFileGenoMap, obj.Position.x, obj.Position.y, Util.IfElse(Session("SvgDefault"), "SVG", "PDF"), obj.ID, Dic.FormatString("FmtAltViewInSvgFile", obj.Name))
			Else					' centre highlight on mid-point of family relationship
				StrHtmlImgFileSvg = Util.FormatString(" <a href='{}?x={},y={},highlight=true,toggle={},name={}' target='popup'><img src='images/svg.gif' class='icon' alt='{&t}' title='{4&t}' /> </a> ", strFileGenoMap, xTopCenter, xyTopRight(1), Util.IfElse(Session("SvgDefault"), "SVG", "PDF"), obj.ID, Dic.FormatString("FmtAltViewInSvgFile", obj.Name))
			End If
		End Select
	End If
	ReportGenerator.NegateAxisY = fFlag
End Function

Function StrHtmlImgTimeline(obj)
	Dim strDate, strData, strLocale, oDate, strAlt, collUnions, u
	strData = obj.Position.GenoMap.Session("TLData")
	If Session("Timelines") And strData <> "" Then
		strLocale=GetLocale
		SetLocale("en-gb")
		Select Case obj.Class
		Case "Individual"
			strDate = Util.FirstNonEmpty(StrFullDate(obj.Birth.Date), StrFullDate(obj.Birth.Baptism.Date), StrFullDate(obj.death.Date), StrFullDate(obj.Death.Disposition.Date))
			strAlt=Dic("AltTimelineImageInd")
		Case "Family"
			Set collUnions = obj.Unions.ToGenoCollection
			For Each u in collUnions
				strDate = Util.FirstNonEmpty(StrFullDate(u.Date), StrFullDate(u.Divorce.Date))
				If IsDate(strDate) Then Exit For
			Next
			strAlt=Dic("AltTimelineImageFam")
		End Select
		On Error Resume Next
		oDate=DateAdd("d",-1,strDate)
		If Err.Number = 0 Then StrHtmlImgTimeline = Util.FormatString(" <a href='timeline.htm?{},date={} {} {}' target='popup'><img src='images/timeline.gif' class='icon' alt='{&t}' title='{4&t}'/> </a> ", _
						  strData, Day(oDate), MonthName(Month(oDate),True), Year(oDate), strAlt)
		On Error Goto 0
		SetLocale(strLocale)
	End If
End Function

' Return individuals name if not blank otherwise if not null generate substitute text for unknown individual
Function StrNameNN(i)
Dim strName
strName = i.Session("NameFull")
If strName <> "" Then
	StrNameNN = strName
ElseIf not Util.IsNothing(i) Then
	StrNameNN = StrDicMFU("_NoName", i.Gender.ID)
Else
	StrNameNN = ""
End If
End Function

' Like ToHtmlHyperlinkNN method except returns blank if Individual object is empty or nothing
Function StrHtmlHyperlinkNN(obj)
	Select Case obj.class
	Case "Individual"
		If obj.Name <> "" Then
			StrHtmlHyperlinkNN = Util.FormatString("<a href='{0}' onclick='javascript:hidePopUpFrame("""");' target='detail'>{1}</a>", obj.Href, StrHtmlHighlightName(obj.Session("NameFull")))
		Else
			StrHtmlHyperlinkNN = Util.HtmlEncode(StrNameNN(obj))
		End If
	End Select
End Function

Function StrHtmlHyperlink(obj)
	Dim strName, arrLocative
	Select Case obj.Class
	Case "Individual"
		StrHtmlHyperlink=Util.FormatString("<a href='{0}' onclick='javascript:hidePopUpFrame("""");' target='detail'>{1}</a>", obj.Href, StrHtmlHighlightName(obj.Session("NameFull")))
	Case "Family"
		StrHtmlHyperlink=Util.FormatString("<a href='{0}' onclick='javascript:hidePopUpFrame("""");' target='detail'>{1}</a>", obj.Href, StrHtmlHighlightName(obj.Session("Name")))
	Case "Place"
		arrLocative = Split(Replace(obj.Session("LocativeRaw"),"]","["),"[") ' break into preposition (if any), name & postpostion(if any)
		StrHtmlHyperlink=Util.FormatString("{0}<a href='place-{1}.htm' onclick='javascript:showPopUpFrame("""");' target='popup'>{2&t}</a>{3}", arrLocative(0), obj.ID, arrLocative(1), arrLocative(2))
	Case "Picture"
		StrHtmlHyperlink=Util.FormatString("<a href='picture-{1}.htm' onclick='javascript:showPopUpFrame("""");' target='popup' title='{2&t}'>{0}</a>", Util.IfElse(Session("fUsePictureId"), obj.ID, Util.FirstNonEmpty(StrFormatText(obj, Trim(StrParseText(obj.Name, True))), Dic("PictureDetails"))), obj.ID, Dic("PictureDetailsTip"))
	Case "SourceCitation"
		StrHtmlHyperlink=Util.FormatString(" <a href='source-{1}.htm' onclick='javascript:showPopUpFrame("""");' target='popup'>{0&t}</a>", JoinSourceCitationNames(obj, obj.title, true), obj.ID)
	Case "SocialEntity"
		StrHtmlHyperlink=Util.FormatString(" <a href='entity-{1}.htm' onclick='javascript:showPopUpFrame("""");' target='popup'>{0&t}</a>", obj.Session("Name"), obj.ID)
	Case Else
			StrHtmlHyperlink = ""
	End Select
End Function

Function StrHtmlHyperlinkTag(obj, strTag)
	Select Case obj.Class
	Case "Individual"
		StrHtmlHyperlinkTag = Replace(obj.ToHtmlHyperlink,">" & obj.Name & "<"," target='detail' onclick='javascript:hidePopUpFrame();' >" & Util.HtmlEncode(obj.TagValue(strTag)) & "<",1,1)
	End Select
End Function


Function StrHtmlHyperlinkPlace(obj)
' Like StrHtmlHyperlink except no preposition included
	Dim arrLocative
	Select Case obj.Class
	Case "Place"
		arrLocative = Split(Replace(obj.Session("LocativeRaw"),"]","["),"[") ' break into preposition (if any), name & postpostion(if any)
		StrHtmlHyperlinkPlace=Util.FormatString(" <a href='place-{1}.htm' onclick='javascript:showPopUpFrame("""");' target='popup'>{0&t}</a>", arrLocative(1), obj.ID)
	Case Else
			StrHtmlHyperlinkPlace = ""
	End Select
End Function

Function StrHtmlTag(strValue, strTag)
	If strValue <> "" Then
		StrHtmlTag = "<" & strTag & ">" & strValue & "</" & strTag & ">"
	End If
End Function

Function StrJsonDescription(strData)
	StrJsonDescription= Util.FormatPhrase(",'description' : '{0}'",Util.FormatString("{&j}", Util.StrFirstCharUCase(strData)))
End Function
Function StrJsonDescription2(strData)
        Dim cch
        cch = Report.BufferLength
        Report.WriteText strData
        StrJsonDescription2 = StrJsonDescription(Report.Buffer(cch))
	Report.BufferLength = cch
End Function

' Generate the code to display text at the bottom of the status bar when the mouse is over a link or an image
Function StrMouseOver(s)
	StrMouseOver = Util.FormatString("onmouseover=""return ss('{&j}')"" onmouseout=""cs()"" title='{0&t}'", s)
End Function

Function WriteOccupancyEvents (oTLInfo, obj, strTitle, fYearOnly)
	Dim collContacts, o, cchBegin, cchStart, strYear, oStart, oEnd, nEvent, strGender, strRelative, strPnP, fExtant, nPlural
	Set collContacts = obj.Contacts.ToGenoCollection
	For Each o in collContacts
		oStart = ""
		oEnd = ""
		cchStart = Report.BufferLength
		If (o.DateStart <> "") Then Set oStart = o.DateStart
		If (o.DateEnd <> "") Then Set oEnd = o.DateEnd
		strGender = Util.FirstNonEmpty(CustomTag(obj,"Gender.ID"), "N")
		nPlural = Util.IfElse(IsFalse(CustomTag(obj,"Plural")),1,2)
		strPnP = Dic.Plurial(Util.IfElse(Dic.Peek("PnP_" & strGender)<>"", "PnP_" & strGender,"PnP_"), nPlural)
		strRelative = Dic.Plurial(Util.IfElse(Dic.Peek("PnR_" & strGender)<>"", "PnR_" & strGender,"PnR_"), nPlural)
		fExtant = (CustomTag(obj, "Extant") <> "N")
		oTLInfo.AddEvent obj, oStart, oEnd, fYearOnly, strTitle & " - " & Util.FormatString(StrDicOrTag("Timeline_" & o.Type.ID, CustomTag(o, "NarrativeStyle")), o.Place.Session("NameSort")), _
			StrJsonDescription2(Util.FormatPhrase(Util.FirstNonEmpty(StrDicOrTag("PhOT_" & o.Type.ID, CustomTag(o, "NarrativeStyle")), _
                               Dic.Lookup2("PhOT_" & o.Type.ID & "_" & obj.Class, "PhOT_" & o.Type.ID)), _
                               strTitle, strRelative, StrDateSpan(o.DateStart, o.DateEnd), _
                               Util.IfElse(o.DateStart <> o.DateEnd, o.Duration, ""), _
                               (Not fExtant Or (o.DateEnd.ToStringNarrative<>""))=False, _
                               StrHtmlHyperlink(o.Place), o.Summary, o.Place.Session("Hlink")))
	Next
End Function
Function WriteFamilyEvents (oTLInfo, f, strSuffix, fYearOnly, fChildren)
	Dim collUnions, u, d, cchBegin, cchStart, strYear, oStart, oEnd, collChildren, nEvent, arrOfficiatorTitle, strTitle
	Dim oRepertoryNonBio
	Set oRepertoryNonBio = Session("oRepertoryNonBio")
	Set collUnions = f.Unions.ToGenoCollection
	For Each u in collUnions
		oStart = ""
		oEnd = ""
		Set d = u.Divorce
		cchStart = Report.BufferLength
		If (u.Date <> "") Then Set oStart = u.Date
		If (d.Date <> "") Then Set oEnd = d.Date
		strTitle = Util.FirstNonEmpty(StrDicOrTag("Union", CustomTag(u, "NarrativeStyle")), Dic("Marriage")) & " " & strSuffix
		If IsObject(oStart) Then
			arrOfficiatorTitle = Split(u.Officiator.Title & "|", "|")
			If arrOfficiatorTitle(1) = "" Then arrOfficiatorTitle(1) = arrOfficiatorTitle(0)
			If IsObject(oEnd) Then
				oTLInfo.AddEvent f, oStart, oEnd, fYearOnly, strTitle, _
						StrJsonDescription(Util.FormatPhrase(StrDicOrTag("PhTL_Union", CustomTag(u,"NarrativeStyle")), Dic.Plurial("PnP_", 2), u.Type, u.Date.ToStringNarrative, u.Place.Session("Locative"), arrOfficiatorTitle(0), u.Officiator, u.Witnesses, StrVerb("ToBe", f.AreTogether, False, "2", ""), arrOfficiatorTitle(1)) & " " & _
								Util.FormatPhrase(StrDicOrTag("PhTL_Divorce", CustomTag(u,"NarrativeStyle")), u.IsAnnulled, d.Date.ToStringNarrative, d.Place.Session("Locative"), d.RequestedBy.ID, _
									 d.RequestedBy, d.Attorney.Husband, d.Attorney.Wife, d.Officiator))
			Else
				oTLInfo.AddEvent f, oStart, "", fYearOnly, strTitle, _
						StrJsonDescription(Util.FormatPhrase(StrDicOrTag("PhTL_Union", CustomTag(u,"NarrativeStyle")), Dic.Plurial("PnP_", 2), u.Type, u.Date.ToStringNarrative, u.Place.Session("Locative"), arrOfficiatorTitle(0), u.Officiator, u.Witnesses, StrVerb("ToBe", f.AreTogether, False, "2", ""), arrOfficiatorTitle(1)))
			End If
		End If
		If IsObject(oEnd) And Not IsObject(oStart) Then
				oTLInfo.AddEvent f, oEnd, oEnd, fYearOnly, strTitle & " " & Dic("DivorceAbbr"), _
						StrJsonDescription(Util.FormatPhrase(StrDicOrTag("PhTL_Divorce", CustomTag(u,"NarrativeStyle")), u.IsAnnulled, d.Date.ToStringNarrative, d.Place.Session("Locative"), d.RequestedBy.ID, _
							 d.RequestedBy, d.Attorney.Husband, d.Attorney.Wife, d.Officiator))
		End If
	Next
	If fChildren Then
		Set collChildren = f.Children.ToGenoCollection
		For Each c in collChildren
			If Not c.IsAdopted = "Y" Then
				WriteIndividualEvents oTLInfo, c, Dic.LookupEx("Child_", c.Gender.ID) & " " & Replace(c.Session("NameFull"), Session("MarkerFirstName"), ""), False
			Else
				If oRepertoryNonBio.KeyCounter("I" & c.ID & "F" & f.ID) > 0 Then
					Set oLink = oRepertoryNonBio.Entry("I" & c.ID & "F" & f.ID).Object(0)
					WriteIndividualEvents oTLInfo, c, Dic.FormatString("TimelineAdopted", StrDicMFU("Pedigree" & oLink.PedigreeLink.ID,c.Gender.ID), Dic.LookupEx("Child_", c.Gender.ID), Replace(c.Session("NameFull"), Session("MarkerFirstName"), "")), False
					If oLink.Adoption.Date <> "" Then
						oTLInfo.AddEvent "", oLink.Adoption.Date, , fYearOnly, Dic("Pedigree" & oLink.PedigreeLink.ID & "Event"),""
					End If
				End If
			End If
		Next
	End If
End Function

Sub WriteHtmlAdditionalInformation(obj)
' Write details of this object's Custom Tags to the report
	Dim oCustomTagRepertory, oCustomTagDictionary, Layout, Layouts, i, j, cchBufferBegin, cchBufferStart, cchBufferNow
	Dim strCustomTagData, strCustomTagDesc, strPrivate, strTag, strFmtTemplate, Args(), strSubHead, strGender
	strPrivate = LanguageDictionary.Peek("Private")
	cchBufferBegin = Report.BufferLength
	Set oCustomTagRepertory = Session("oCustomTagRepertory")

	Report.WriteLn	"<div class='clearleft'><br /><ul class='xT'>"
	Report.WriteFormattedLn "    <li class='xT2-{} xT-h' onclick='xTclk(event,""2"")'>", Util.IfElse(Session("fCollapseReferences"), "c", "o")
	Report.WriteFormattedLn "<a name='Additional_Information'></a><h3 class='xT-i inline'>{&t}</h3><ul class='xT-h'>", Util.StrFirstCharUCase(Util.FormatPhrase(Dic("FmtAdditionalInformation"), LCase(Dic(obj.Class))))

	If obj.Class = "Individual" Then ' List any External Hyperlink or Blood Type here
		cchBufferNow = Report.BufferLength
		If obj.Hyperlink <> "" Then Report.Write Util.FormatPhrase(Dic("PhExternalLink"), obj.Hyperlink)
		Report.WritePhraseDic("PhBloodType"), obj.Name.short, obj.Birth.BloodType, obj.IsDead=false
		If Report.BufferLength > cchBufferNow Then ' some phrase written
			cchBufferBegin= -1	  ' indicate data present in Additional Information section
		End If
	End If
	If oCustomTagRepertory.KeyCounter(obj.Class) > 0 Then ' Custom tags exist for this object
		Layouts = oCustomTagRepertory.Entry(obj.Class).Count
		Set oCustomTagDictionary = oCustomTagRepertory(obj.Class)
	End If

	For i = 1 to Layouts - 1

		Layout = oCustomTagRepertory.Entry(obj.Class).Object(i)
		cchBufferStart = Report.BufferLength


		' check if this Custom Tag Dialog Layout has an associated phrase in the Language Dictionary
		strFmtTemplate = Util.FirstNonEmpty(Layout(2), LanguageDictionary.Peek("PhCT_" & Replace(Layout(0)," ","")))

		If strFmtTemplate <> "" Then			' create a custom phrase
			Report.WriteLn "<li class='xT2-o xT-h' onclick='xTclk(event,""2"")'>"
			Report.WriteFormattedLn "<span class='xT-i subhead bold'>{&t}</span><ul class='xT-h'><li>", Layout(1)
			ReDim Args(Ubound(Layout)+8)
			Args(0) = obj & ""  ' default property e.g. name
			Select Case obj.Class
			Case "Individual"
				Args(0) = obj.Name.short
				Args(1) = PnP(obj)
				Args(2) = PnR(obj)
				Args(3) = PnO(obj)
				Args(4) = Not obj.IsDead
			Case "Family"
				Args(1) = Dic.Plurial("PnP_", 2)
				Args(2) = Dic.Plurial("PnR_", 2)
				Args(3) = Dic.Plurial("PnO_", 2)
				Args(4) = obj.AreTogether
			Case "Marriage"
				Args(1) = Dic.Plurial("PnP_", 2)
				Args(2) = Dic.Plurial("PnR_", 2)
				Args(3) = Dic.Plurial("PnO_", 2)
				Args(4) = Not obj.AreTogether
			Case Else
				strGender = Util.FirstNonEmpty(CustomTag(obj, "Gender.ID"), CustomTag(obj, "Name.Gender.ID"), "N")
				Args(1) = Dic("PnP_" & strGender)
				Args(2) = Dic("PnR_" & strGender)
				Args(3) = Dic("PnO_" & strGender)
				Args(4) = (CustomTag(obj, "Extant") <> "N")
			End Select
			' create fixed part of Report.WritePhrase statement. N.B. params 8 & 9 are reserved but not used at present
			strExecute = "Report.WritePhrase strFmtTemplate, Args(0), Args(1), Args(2), Args(3), " & Util.IfElse(Args(4),"True","False") & _
									 ",""<"", "">"", ""&"", Chr(39), Chr(34)"
			' now add Custom Tag contents as param 10 onwards.
			For j = 3 to Ubound(Layout)
				strTag = Layout(j)
				If strTag <> "" Then
					Args(j+7) = StrFormatText(obj, CustomTag(obj,strTag))
				End If
				strExecute = strExecute & ", Args(" & j+7 & ")"
			Next
			cchBufferNow = Report.BufferLength
			Execute strExecute
			If Report.BufferLength > cchBufferNow Then
				cchBufferStart = -1	  ' indicate at least one value present in this Custom Tag Dialog Layout
			End If

			Report.WriteLn "</li></ul></li>"
		Else						' no custom template
								' so create a collapse/expand section with the
								' custom tags in a table.

			Report.WriteFormattedLn "<li class='xT2-{} xT-h' onclick='xTclk(event,""2"")'>", Util.IfElse(Session("fCollapseReferences"), "c", "o")
			Report.WriteFormattedLn "<span class='xT-i subhead bold'>{&t}</span><ul class='xT-h'><li><table class='customtagtable'>", Layout(1)
			For j = 3 to Ubound(Layout)
				strTag = Trim(Layout(j))
				strCustomTagData = Util.IfElse(strTag <> "", CustomTag(obj,strTag), "")

				If strCustomTagData <> "" Then
					strCustomTagDesc = oCustomTagDictionary.KeyValue(strTag)
					Report.WriteFormattedLn "<tr><td>{&t}</td><td>{}</td></tr>",strCustomTagDesc, StrFormatText(obj, strCustomTagData)
					cchBufferStart = -1	  ' indicate at least one value present in this Custom Tag Dialog Layout
				End If
			Next

			Report.WriteLn "</table></li></ul></li>"
		End If

		If cchBufferStart > 0 Then ' no Custom Tags set in this Dialog Layout Section so remove phrase or table
			Report.BufferLength = cchBufferStart
		Else
			cchBufferBegin = -1 ' indicate at least one custom tag set
		End If
	Next
	Report.WriteLn "</ul></li></ul></div>"
	If cchBufferBegin > 0 Then	' no Custom tags present so remove the Additional Information section
		Report.BufferLength = cchBufferBegin
	Else
		g_ichReferencesStart = -1	' indicate at least one expand/collapse non-note item present
	End If
End Sub

Sub WriteHtmlRelationships(obj)
	Dim strPnO, strPnp, strTitle, fAlive, fExtant, r, oRepertoryEntity, strConnection, strConnections, strName, strNameO, strNameP
	strPnP = PnP(obj)
	strPnO = Util.StrFirstCharUCase(PnO(obj))

	Set oRepertoryEntity1 = Session("oRepertoryEntity1")
	Set oRepertoryEntity2 = Session("oRepertoryEntity2")

	If oRepertoryEntity1.KeyCounter(obj.ID) > 0 Or _
		oRepertoryEntity2.KeyCounter(obj.ID) > 0 Then
		Report.WriteLn	"<div class='clearleft'><br /><ul class='xT'>"
		Report.WriteFormattedLn "    <li class='xT2-{} xT-h' onclick='xTclk(event,""2"")'>", Util.IfElse(Session("fCollapseReferences"), "c", "o")
		Report.WriteFormattedLn "<a name='Relationships'></a><h3 class='xT-i inline'>{&t}</h3><ul class='xT-h'><li>", Dic("Relationships")
		If oRepertoryEntity1.KeyCounter(obj.ID) > 0 Then
			Set oRepertoryEntity = oRepertoryEntity1.Entry(obj.ID)
			strName = obj.Session("NameShort")
			strNameO = strName
			strNameP = obj.Session("NamePossessive")
			For Each r In oRepertoryEntity
				Report.WriteLn "<div class='clearleft'>"
				If (r.Session("PicturesIncluded") > 0) Then
					Report.WriteLn "<div class='floatleft aligncenter widthpaddedsmall'>"
					WriteHtmlPicturesSmall r, "left", Session("fHidePictureName")
					Report.WriteLn "</div>"
				End If
				WriteHtmlRelationship r, strName, strNameO, "", "", False, True, strNameP, ""
				WriteHtmlAdditionalInformation(r)
				WriteHtmlAnnotation r, Dic("AnnotationRelationship"), r.Comment
				strName = strPnP
				strNameO = strPnO
				Report.WriteLn "</div>"
			Next
		End If
		If oRepertoryEntity2.KeyCounter(obj.ID) > 0 Then
			Set oRepertoryEntity = oRepertoryEntity2.Entry(obj.ID)
			strName = obj.Session("NameShort")
			strNameO = strName
			strNameP = obj.Session("NamePossessive")
			For Each r In oRepertoryEntity
				Report.WriteLn "<div class='clearleft'>"
				If (r.Session("PicturesIncluded") > 0) Then
					Report.WriteLn "<div class='floatleft aligncenter widthpaddedsmall'>"
					WriteHtmlPicturesSmall r, "left", Session("fHidePictureName")
					Report.WriteLn "</div>"
				End If
				strConnection = ""
				If r.Class = "SocialRelationship" Then
					strConnection = r.Connection.ID
				Else
					strConnection = r.EmotionalLink.ID
				End If
				Select Case strConnection
				Case "Roommate", "LivesWith", "Neighbor", "Acquaintance", "Associate", "Know", "Relative", "WorkWith", "" ' two way relationship so keep individual as subject (i.e. switch)
					WriteHtmlRelationship r,  r.entity1.Session("HlinkNN"),"", strName, strNameO, True, True, "", StrNameP
				Case Else
					If strConnection = "" Then strConnection = " "
					Select Case Left(strConnection,3)
					Case "Abu", "Man", "Con", "Foc", "Fan", "Lim", "Jea"
						WriteHtmlRelationship r, "", "", strName, strNameO, False, True, "", strNameP
					Case Else
						If r.Class = "EmotionalRelationship" Then
							WriteHtmlRelationship r,  r.Entity1.Session("HlinkNN"),"", strName, strNameO, True, True, "", strNameP
						Else
							WriteHtmlRelationship r, "", "", strName, strNameO, False, True, "", strNameP
						End If
					End Select
				End Select
				WriteHtmlAdditionalInformation(r)
				WriteHtmlAnnotation r, Dic("AnnotationRelationship"), r.Comment
				Report.WriteLn "</div>"
				strName = strPnP
				strNameO = strPnO
			Next
		End If

		cchBufferBegin = -1	  ' indicate data present in other details section
		g_ichReferencesStart = -1

		Report.WriteLn "</li></ul></li></ul><div class='clearleft'></div></div>"
	End If
End Sub

' Write the HTML code to display notes and comments for birth, death, education, occupation, etc.
Sub WriteHtmlAnnotation(obj, strAnnotationType, strAnnotationCommentFull)
	Dim strAnnotationComments, strAnnotationComment
	strAnnotationComment = StrFormatText(obj, strAnnotationCommentFull)
	If (strAnnotationComment <> "") Then
		g_ichNotesStart = -1	' Use a negative value to indicate the presence of an annotation
		Report.WriteFormattedLn	"<ul class='xT note'>" & vbNewline & _
				     	"  <li class='xT-{} xT-h' onclick='xTclk(event,"""")'>{&t}" & vbNewline & _
				     	"    <ul class='xT-n'>" & vbNewline & _
				     	"     <li class='xT-b xT-n'>{}" & vbNewline & _
				     	"     </li>" & vbNewline & _
				     	"    </ul>" & vbNewline & _
					"  </li>" & vbNewline & _
					"</ul>" & vbNewline, _
					Util.IfElse(Session("fCollapseNotes"), "c", "o"), strAnnotationType, strAnnotationComment
	End If
End Sub
' as above but get result as string
Function StrHtmlAnnotation(obj, strAnnotationType, strAnnotationCommentFull)
	Dim cchBuffer
	cchBuffer = Report.BufferLength
	WriteHtmlAnnotation obj, strAnnotationType, strAnnotationCommentFull
	StrHtmlAnnotation = Report.Buffer(cchBuffer)	' Get the text from the output buffer
	Report.BufferLength = cchBuffer	' Truncate the buffer to its original length
End Function

' Write the HTML code to display the comment of the primary picture (if present)
' If the picture does not have a description, the code must be written, otherwise
' the slideshow will abort by a script error
Sub WriteHtmlAnnotationPicture(strAnnotationType, obj, strAlign, nWidth )

	Dim p, strId, strClass, strDescription
	Set p = obj.Session("PictureMain")	' Get the main picture of the object
	If (Not Util.IsNothing(p)) Then
		strId = obj.ID
		strClass = "show"
		strDescription = StrFormatText(p, p.Description)
		If (strDescription = "") Then
			strDescription = "&#32;"
			strClass = "hide"
		Else
			g_ichNotesStart = -1	' Use a negative value to indicate the presence of an annotation
		End If
		Report.WriteFormattedLn "<ul id='idPVv_{}' class='xT {} note'>", strId, strClass
		Report.WriteFormattedLn "    <li class='xT-{} xT-h' onclick='xTclk(event,"""")'>{&t}", Util.IfElse(Session("fCollapseNotes"), "c", "o"), Dic.FormatString("FmtAnnotationPicture", strAnnotationType)
		Report.WriteFormattedLn "        <ul class='xT-n'><li id='idPVd_{}' class='xT-b xT-n'>{}</li></ul>", strId, strDescription
		Report.WriteLn          "    </li>"
		Report.WriteLn          "</ul>"
	End If
End Sub

' Write details associated with a main picture with a specific HTML id so that it can be overwritten for each picture in a slideshow if required
Sub WriteHtmlDetailsPicture(obj, fNoName, fBr)
	Dim p, strId
	Set p = obj.Session("PictureMain")	' Get the main picture of the object
	If Not (p Is Nothing) And p.PictureDimension <> "" Then
		strId = obj.ID
		Report.WriteFormattedLn "<div class='caption' id='idPVc_{}'>{}</div>", strId, LanguageDictionary.FormatPhrase("PhPictureDetailsHtml", Util.IfElse(fNoName, "",StrHtmlTag(StrFormatText(p, Trim(StrParseText(p.Name, True))),"strong")), p.Date.ToStringNarrative, p.Place.Session("HlinkLocative"), p.Source.Session("Hlink"))
	End If
End Sub

' Write a reference to a footnote item
' This routine requires the presence of a GenoCollection object named g_collFootnotes to store
' the unique footnotes.
Sub WriteHtmlFootnoteRef(oFootnote)
	If (Not Util.IsNothing(oFootnote)) Then
		Dim iFootnote		' Zero-based index representing the position where the footnote is found in the collection
		iFootnote = g_collFootnotes.AddUnique(oFootnote)
		Report.WriteFormatted "<sup><a href='#{0}' title='{}'>{0}</a>&nbsp;</sup>", iFootnote + 1, Dic("SourceFootnote")
	End If
End Sub

' Write a reference for two footnotes.  If both footnotes are identical,
' then write only a single footnote
Sub WriteHtmlFootnoteRef2(oFootnote1, oFootnote2)
'	If (Not Util.AreObjectsEqual(oFootnote1, oFootnote2)) Then
	If oFootnote1 <> oFootnote2 Then
		WriteHtmlFootnoteRef oFootnote1
	End If
	WriteHtmlFootnoteRef oFootnote2
End Sub

Sub WriteHtmlFootnoteRefs(oFootnotes)
	For Each oFootnote in oFootnotes.ToGenoCollection
		WriteHtmlFootnoteRef(oFootnote)
	Next
End Sub

' Write all the footnotes to the report
Sub WriteHtmlAllFootnotes(oSources, asNote)
  Dim collSources
  Set collSources = Util.NewGenoCollection()
  If Not Util.IsNothing(OSources) Then collSources.Add(oSources.ToGenoCollection)
  If (g_collFootnotes.Count > 0) Or (collSources.Count > 0) Then
      If Session("NestSourceRefs") Then
          If asNote then
              Report.WriteLn "<div class='clearleft'><ul class='xT note'>"
              Report.WriteFormattedLn "  <li class='xT-o xT-h' onclick='xTclk(event,"""")'>Source", Dic.Plurial("SourceCitation", 1)
              Report.WriteLn "    <ul class='xT-n'>"
              Report.WriteLn "     <li class='xT-b xT-n'>"
          Else
              Report.WriteLn "<div class='clearleft'><ul class='xT'>"
              Report.WriteFormattedLn "    <li class='xT2-{} xT-h' onclick='xTclk(event,""2"")'>", Util.IfElse(g_fCollapseReferences, "c", "o")
              Report.WriteFormattedLn "<a name='SourcesCitations'></a><h3 class='xT-i inline'>{&t}</h3><ul class='xT-h'><li>", Dic.Plurial("SourceCitation", 2)
              Report.WriteLn "<div class='footnote clearleft'>"
          End If
      Else
          Report.WriteLn "<div class='footnote clearleft'>"
      End If
  		If (g_collFootnotes.Count > 0) Then
  			Dim iFootnote, oFootnote, strTitle, strSep, s
  			iFootnote = 0
  			For Each oFootnote In g_collFootnotes
  				iFootnote = iFootnote + 1
  				strTitle = StrPlainText(oFootnote, Util.FirstNonEmpty(oFootnote.Subtitle, oFootnote.Description, oFootnote.QuotedText, Dic("SourceInformation")))
  				If (strTitle <> "") Then
  					strTitle = Util.FormatString(" title='{}'", strTitle)
  				End If
  				Report.WriteFormattedBr "<sup><a name='{0}'></a>{0} </sup> <a href='source-{&t}.htm' onclick='javascript:showPopUpFrame("""");' target='popup' {}><i>{}</i></a>", iFootnote, oFootnote.ID, strTitle, JoinSourceCitationNames(oFootnote, StrFormatText(oFootnote, StrParseText(oFootnote.title, True)), true)
  				' remove referenced source from list
  				collSources.Remove(oFootnote)
  			Next
  		End If
  		If collSources.Count > 0 Then ' write details of remaining source/citations
  			If Not Session("NestSourceRefs") Then Report.WriteBr Dic.Plurial("SourceCitation" & Util.IfElse(g_collFootnotes.Count > 0, "_Other",""), collSources.Count)
  			strSep = ""
  			For Each oFootnote in collSources
  				strTitle = StrPlainText(oFootnote, Util.FirstNonEmpty(oFootnote.Subtitle, oFootnote.Description, oFootnote.QuotedText, Dic("SourceInformation")))
  				If (strTitle <> "") Then
  					strTitle = Util.FormatString(" title='{}'", strTitle)
  				End If
  				Report.WriteFormatted strSep & " <a href='source-{&t}.htm' onclick='javascript:showPopUpFrame("""");' target='popup' {}><i>{}</i></a>", oFootnote.ID, strTitle, JoinSourceCitationNames(oFootnote, StrFormatText(oFootnote, StrParseText(oFootnote.title, True)), true)
  				strSep = Util.IfElse(Session("NestSourceRefs"), "<br />", ",")
  			Next
  		End If
      Report.WriteBr "</div>"
  		If Session("NestSourceRefs") Then
          Report.Write "</li></ul></li></ul>"
      End If
 			g_collFootnotes.clear
  	End If
End Sub


' This method writes the HTML code to make sure the entire report is accessible from any page.
' Do not remove this safeguard; it may affect the navigation of the report.
' The text is written in English because it is very rare someone will actually read it.  This text is not
' the most eloquent English, however it contains a wealth of keywords for surfers to quickly find your
' genealogy report if published on the web.
' The text should be translated to include keywords in your language.
Sub WriteHtmlFramesetSafeguardK(s, k, o)
	Dim strHref, strName, strClass, strLink
	strHref = "toc_individuals.htm"
	If (Not Util.IsNothing(o)) Then
    Report.WriteLn StrDicExt("FmtHtmlLastModified", "", "<div class='small floatright'><span>Page last modified </span><span  id='lastModified'></span></div>", "", "2.0.1.6 (>01.09.2010)")
		strClass = o.Class
		If (strClass = "Individual") Then
			strName = o.Name.Last
			k = ""
		ElseIf (strClass = "Family") Then
			strName =  o
			strHref = "toc_families.htm"
			k = ""
		End If
	End If
	If Not Session("ForceFrames") Then Exit Sub
	Report.WriteLn "<div id='divFrameset' class='hide'> <hr /><p><br />"
	Report.WriteBr Util.FormatPhrase(Dic("FmtFramesetSafeguard"), strName, strHref, Session("Title"), strClass="Individual",  strClass="Family")
	Report.WriteT3Br "(", k, ")"
	strLink =  Replace(Dic.SearchKeywordHyperlink, "Learn how to build your family tree", Session("SKAltDefault"))
	Report.WriteFormatted "{}.</p><hr /><br /><p class='aligncenter'><small>{}</small></p></div>", strLink, Util.FormatString(Dic("FmtCopyright"), "© 2011 GenoPro Inc.")
End Sub

Sub WriteHtmlFramesetSafeguard(s)
	WriteHtmlFramesetSafeguardK s, "", nothing
End Sub

Function WriteIndividualEvents (oTLInfo, i, strTitle, fYearOnly)
	Dim cchBegin, cchStart, oStart, oEnd, fLink, nEvent, strGender
	Dim b, ba, c, d, f
	cchStart = Report.BufferLength
	strGender = i.Gender.ID
	Set b = i.Birth
	Set ba = b.Baptism
	Set d = i.Death
	Set f = d.Funerals
	Set c = d.Cause
	fLink = (i.Hyperlink.Internal = "Y")
	If b.Date <> "" Then
		Set oStart = b.Date
	ElseIf ba.Date <> "" Then
		Set oStart = ba.Date
	End If
	If d.Date <> "" Then
		Set oEnd = d.Date
	ElseIf f.Date <> "" Then
		Set oEnd = f.Date
	End If
	If fLink Then
		If i.IndividualInternalHyperlink.ID <> "" Then
			 fLink = Not oLinks.Added(i.IndividualInternalHyperlink.ID)
		Else
			fLink = Not oLinks.Added(i.ID)
		End If
	End If
	If Not fLink And IsObject(oStart) Then
		If IsObject(oEnd) Then
			oTLInfo.AddEvent i, oStart, oEnd, fYearOnly, strTitle, _
					StrJsonDescription(Util.FormatPhrase(StrDicMFU("PhTL_Birth", strGender), PnP(i), b.Date.ToStringNarrative, b.Place.Session("Locative"), ba.Date.ToStringNarrative, _
								ba.Place.Session("Locative"), ba.Officiator.Title, ba.Officiator, (b.Place.ID = ba.Place.ID), _
								b.Doctor, b.PregnancyLength.Months,  b.PregnancyLength.Weeks, strPnR, b.CeremonyType, i.Session("NamePossessive"), strGender) & " " & _
							   Util.StrFirstCharUCase(Util.FormatPhrase(StrDicMFU("PhTL_Died", strGender), PnP(i), i.Death.Age.Years, i.Death.Age.Months, i.Death.Age.Days, _
								d.Date.ToStringNarrative, d.Place.Session("Locative"), c, c.Description, i.Birth.Date.Approximation & i.Death.Date.Approximation, strGender)))
		Else
			oTLInfo.AddEvent i, oStart, , fYearOnly, strTitle, _
					StrJsonDescription(Util.FormatPhrase(StrDicMFU("PhTL_Birth", strGender), PnP(i), b.Date.ToStringNarrative, b.Place.Session("Locative"), ba.Date.ToStringNarrative, _
								ba.Place.Session("Locative"), ba.Officiator.Title, ba.Officiator, (b.Place.ID = ba.Place.ID), _
								b.Doctor, b.PregnancyLength.Months,  b.PregnancyLength.Weeks, strPnR, b.CeremonyType, i.Session("NamePossessive"), strGender))
		End If
	End If
	If Not fLink And IsObject(oEnd) And Not IsObject(oStart) Then
		oTLInfo.AddEvent i, oEnd, oEnd, fYearOnly, strTitle & " " & Dic("DiedAbbr"), _
			StrJsonDescription(Util.FormatPhrase(StrDicMFU("PhTL_Died", strGender), PnP(i), i.Death.Age.Years, i.Death.Age.Months, i.Death.Age.Days, d.Date.ToStringNarrative, d.Place.Session("Locative"), c, c.Description, i.Birth.Date.Approximation & i.Death.Date.Approximation, strGender))
	End If
End Function

' Write event details as a JSON array element for the MIT Simile Timeline 'widget'.


' Write the report description for the META tag.
' This routine is used by default.htm, header.htm and home.htm.
Sub WriteMetaDescriptionReport

	Report.WritePhraseDic "FmtMetaDescReport1", Session("Title"), Individuals.Count, Families.Count
	Report.WriteText " " & Dic("FmtMetaDescReport2") & " "

	Dim oStringDictionaryNames, iName, iNameLast, strSep
	Set oStringDictionaryNames = Session("oStringDictionaryNames")
	If (Not Util.IsNothing(oStringDictionaryNames)) Then
		iNameLast = oStringDictionaryNames.Count - 1
		If (iNameLast > 9) Then
			iNameLast = 9		' Keep only the first 10 families
		End If
		strSep = ""
		For iName = 0 To iNameLast
			Report.WriteText strSep & oStringDictionaryNames.Key(iName)
			strSep = ", "
		Next
	End If
	Report.WriteText "."
End Sub

' Write the report keywords for the META tag.
Sub WriteMetaKeywordsReport
	Report.Write Dic("FmtMetaKeyWordsReport")
End Sub

Function StrFormatText(obj, strRawText)
'
' Handles text 'processing instructions' embedded in Comment, Descriptions, Custom Tags etc.
'
	Dim strPart, strParts, strSubParts, strParams, strParam, strResult, strText, i, j, strUID, strMode, strTemp, strClass, arrArgs(15)
	strText = StrParseText(strRawText, True)
	If strText = "" or strText = "<?text?>" Then
		StrFormatText = ""
		Exit Function
	End If
	strClass = "Document"
	If Not IsNull(obj) Then strClass = obj.Class
	If Left(strText,7)="<?off?>" Then
		StrFormatText=Util.HtmlEncode(Mid(strText,8))
		Exit Function
	End If
	strMode = "<?text?>"
	strParts = split(strText, "<?")
	strSubParts = split(strParts(0),Dic("Private"))
	strResult = Util.HtmlEncode(strSubParts(0))		' get any leading text less any old format private section
	For i=1 to Ubound(strParts)
		strSubParts = split(strParts(i), "?>")
		If Ubound(strSubParts) <> 1 Then Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), obj, strRawText)
		strParams = split(strSubParts(0), " ")
		Select Case LCase(strParams(0))
			Case "off" ' turn off custom markup processing i.e. treat everything after <?off?> directive as standard text
				strResult = strResult + Util.HtmlEncode(mid(strText, Instr(strText, "<?off?>")+7))
				Exit For
			Case "html"
				strResult = strResult & strSubParts(1)
				strMode = "<?" & strSubParts(0) & "?>"
			Case "text"
				strResult = strResult & Util.HtmlEncode(strSubParts(1))
				strMode = "<?" & strSubParts(0) & "?>"
			Case "hide", "plain"
			Case "image"
				strParams = Split(Trim(Mid(strSubParts(0),6)),"""")
				If Ubound(strParams)  <> 2 And UBound(strParams) <> 0 Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				Else
					If UBound(strParams) = 2 Then
						If Trim(strParams(0)) <> "" Then Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), obj, strSubParts(0))
						strTemp = strParams(1)
						strParam = Session("eSpace").Replace(strParams(2), " ") & "  "
						strParams = Split(strParam ," ")
						strParams(0) = strTemp
						strTemp = ""
					Else
						strTemp = Trim(Session("eSpace").Replace(strParams(0), " "))
						strParams = Split(strTemp & "  "," ")
						strTemp=Session("oPicMaps").KeyValue(strParams(0))
						strParams(0) = Session("oPicIndex")(strParams(0)).Path.Report
					End If
					strMap = ""
					If strTemp <> "" Then strMap = StrNewUID
					strResult = strResult & Util.FormatString("<div width='95%' style='text-align:center; overflow:auto;'>" & _
								"<img src='{}' class='pic' {}/>", _
								strParams(0), Util.FormatPhrase("[ width='{0}'][ height='{1}'][ usemap='#map{2}']", strParams(1), strParams(2), strMap))
					If strTemp<>"" Then strResult = strResult & Util.FormatString("<map name='map{}'>{}</map><div class='note'>{}</div>", strMap, strTemp, Dic("PictureMapHint"))
					strResult = strResult & "</div>"
					If UBound(strSubParts) > 0 Then strResult = strResult & StrFormatText(obj, strMode & strSubParts(1))
				End If
			Case "merge"
				strParams = Split(Trim(Mid(strSubParts(0),6)),"""")
				strResult = strResult & StrMergeText(obj, strMode, strParams, 0)
				If UBound(strSubParts) > 0 Then strResult = strResult & StrFormatText(obj, strMode & strSubParts(1))
			Case "note"
				strParams = Split(Trim(Mid(strSubParts(0),5)),"""")
				If Ubound(strParams)  < 2 Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"),strClass, strSubParts(0))
				ElseIf Trim(strParams(0)) <> "" Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"),strClass, strSubParts(0))
				Else
					strResult = strResult & StrHtmlAnnotation(obj, strParams(1), "<?html?>" & StrMergeText(obj, strMode, strParams, 2))
					If UBound(strSubParts) > 0 Then strResult = strResult & StrFormatText(obj, strMode & strSubParts(1))
				End If
			Case "popup"
				strParams = Split(Trim(Mid(strSubParts(0),6)),"""")
				If Ubound(strParams)  < 4 Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				ElseIf (Trim(strParams(0)) & Trim(strParams(2))) <> "" Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				Else
					strUID = StrNewUid
					strResult = strResult & Util.FormatString("<div class='std'><a href=""javascript:savePopupContent('popup{}', '{&j}');displayPopup();showPopUpFrame('');"">{}</a></div>", strUID, strParams(1), strParams(3))
					strResult = strResult & Util.FormatString("<div id=""popup{}"" style=""display:none"">{}</div>", strUID, StrMergeText(obj, strMode, strParams, 4))
					If UBound(strSubParts) > 0 Then strResult = strResult & StrFormatText(obj, strMode & strSubParts(1))
				End If
			Case "subsection"
				strParams = Split(Trim(Mid(strSubParts(0),11)),"""")
				If Ubound(strParams)  < 2 Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				ElseIf Trim(strParams(0)) <> "" Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				Else
					strResult = strResult & StrHtmlSubSection(obj, strParams(1), StrMergeText(obj, strMode, strParams, 2))
					If UBound(strSubParts) > 0 Then strResult = strResult & StrFormatText(obj, strMode & strSubParts(1))
				End If
			Case "url"	' with thanks & acknowledgement to 'BobWebster' on the GenoPro forum
				 if Ubound(strParams) >= 1 Then
						strParams = Split(Trim(Mid(strSubParts(0),4)) & "\", "\")
					strTemp = strParams(0)
					If instr(strParams(0), "://") = 0 Then strParams(0) = "http://" & strParams(0)
					strResult = strResult & "<a target=""_blank"" href=""" & strParams(0) & """>" & Util.HtmlEncode(Util.FirstNonEmpty(strParams(1), strTemp)) & "</a>" & Util.HtmlEncode(strSubParts(1))
				Else
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				End If
			Case "email", "mail"
				If Ubound(strParams) >= 1 Then
					strParams = Split(Trim(Mid(strSubParts(0),6)) & "\", "\")
					strTemp = strParams(0)
					strResult = strResult & "<a href=""mailto:" & strParams(0) & """>" & Util.HtmlEncode(Util.FirstNonEmpty(strParams(1), strTemp)) & "</a>" & Util.HtmlEncode(strSubParts(1))
				Else
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				End If
			Case "movie"
				strParams=Split(Trim(Mid(strSubParts(0),7))," ")
				If Ubound(strParams)  < 2 Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				ElseIf Trim(strParams(0)) = "" Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				Else
					strParams = Split(Trim(Mid(strSubParts(0),7)),"""")
					strParam = ""
					For j = 0 to Ubound(strParams) Step 2
						strTemp = Trim(strParams(j))
						If strTemp <> "" Then strParam = strParam & "|" & Join(split(strTemp," "), "|")
						If j<Ubound(strParams) Then strParam = strParam & "|" & strParams(j+1)
					Next
					strArgs = Split(strParam & "|||||||||", "|")
					strTemp=Split(Trim(Mid(strSubParts(0),7)) & "       "," ")
					If Left(strTemp(1),1) <> """" Then strArgs(2) = Session("oPicIndex")(strArgs(2)).Path.Report
					strResult = strResult & Util.FormatPhrase(Dic("PhMovie_" & strArgs(1)), strArgs(2), strArgs(3), strArgs(4), strArgs(5), strArgs(6), strArgs(7), strArgs(8), strArgs(9)) & Util.HtmlEncode(strSubParts(1))
				End If
			Case "phrase"
				strParams = Split(Trim(Mid(strSubParts(0),7)),"""")
				If Ubound(strParams)  < 2 Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				ElseIf Trim(strParams(0)) <> "" Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, strSubParts(0))
				Else
					strTemp = ""
					For j = 1 to Ubound(strParams) Step 2
						strTemp = strTemp & ",""" & strParams(j) & """"
						strParam = Trim(strParams(j+1))
						If strParam <> "" Then strTemp = strTemp & ",CustomTag(obj, """ & Join(split(strParam, " "), """),CustomTag(obj, """) & """)"
					Next
					On Error Resume Next
					strResult = strResult & eval("Util.FormatPhrase(" & Mid(strTemp,2) & ")")
					If Err Then Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), strClass, "Util.FormatPhrase(" & Mid(strTemp,2) & ")" & ": " & Err.Description)
					Err.Clear
					On Error Goto 0
				End If
			Case Else Report.LogError Util.FormatString(ConfigMessage("ErrorTextToken"), strClass, strParams(0))
		End Select
	Next
	StrFormatText = strResult
End Function

Function StrHtmlHighlightName(strName)
	Dim strMarker, nStart, nEnd
	strMarker = Session("MarkerFirstName")
	nStart = Instr(strName, strMarker)
	If nStart > 0 Then
		nEnd = Instr(nStart, strName, " ")
		If nEnd > 0 Then
			StrHtmlHighlightName = Util.HtmlEncode(Left(strName, nStart-1)) & "<span class='namehighlight'>" & Util.HtmlEncode(Mid(strName, nStart+1, nEnd-nStart-1)) & "</span>" & StrHtmlHighlightName(Mid(strName,nEnd))
		Else
			StrHtmlHighlightName = Util.HtmlEncode(Left(strName, nStart)) & "<span class='namehighlight'>" & Util.HtmlEncode(Mid(strName, nStart+1)) & "</span>"
		End If
	Else
		StrHtmlHighlightName = Util.HtmlEncode(strName)
	End If
End Function

Function StrHtmlSubSection(obj, strSectionType, strContent)
	If (strContent <> "") Then
		g_ichReferencesStart = -1 ' indicate at least one collapse/expand non-notes section present
		StrHtmlSubSection = Util.FormatString("<ul class='xT std'>" & vbNewline & _
				     	"  <li class='xT2-{} xT-h' onclick='xTclk(event,""2"")'><h3 class='xT-i inline'>{&t}</h3>" & vbNewline & _
				     	"    <ul class='xT-h'>" & vbNewline & _
				     	"     <li>{}" & vbNewline & _
				     	"     </li>" & vbNewline & _
				     	"    </ul>" & vbNewline & _
					"  </li>" & vbNewline & _
					"</ul>" & vbNewline, _
					Util.IfElse(Session("fCollapseReferences"), "c", "o"), strSectionType, strContent)
	End If
End Function

Function StrJavaScriptEncode(strValue)
' do proper JavaScript encoding, unlike Util.JavaScriptEncode
	StrJavaScriptEncode = Replace(Replace(Replace(Replace(Replace(strValue, "\", "\\"),"""","\"""),"'","\'"), vbTab, "\t"), vbLineFeed, "\n")
End Function


Function StrMergeText(obj, strMode, strParams, nFirst)
	Dim strResult, i
	For i=nFirst To Ubound(strParams) Step 2
		If strParams(i) <> "" Then strResult = strResult & StrMergeTags(obj, strMode, Split(strParams(i)))
		If i < Ubound(strParams) Then strResult = strResult & strParams(i+1)
	Next
	StrMergeText = strResult
End Function

Function StrMergeTags(obj, strMode, strParams)
'=============================================
	Dim strResult
	For Each strCode In strParams
		If strCode <> "" Then strResult = strResult & StrFormatText(obj, strMode & CustomTag(obj, strCode))
	Next
	StrMergeTags = strResult
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function StrNormalizeSpace(strText)
	Dim oMatches, oMatch, strResult, oRegExP
	strResult = strText
	Set oRegExp = New RegExp
	oRegExp.Global = True
	oRegExp.Pattern = "\s\s+"
	Set oMatches = oRegExp.Execute(strText)
	For Each oMatch in oMatches
		strResult = Replace(strResult, oMatch.Value, Left(oMatch.Value,1))
	Next
	StrNormalizeSpace = strResult
End Function

'------------------------------------------------------------------------------------------------------------------------------------------------------
Function StrParseText(strRawText, fUseLangShowOthers)
'=============================
' check for language specific sections, making skin language sections visible by default
Dim arrParts, arrSubParts, strResult, i, strLang, strTemp, strText, strSep, fLangShowOthers
fLangShowOthers = False
If fUseLangShowOthers Then fLangShowOthers = Session("LangShowOthers")
If VarType(fLangShowOthers) <> vbBoolean Then
   Report.LogError "Error: Configuration parameter 'LangShowOthers' is invalid " & VarType(fLangShowOthers) & " / " & Session("LangShowOthers")
   fLangShowOthers = False
End If
If Instr(strRawText,"<?off?>") = 1 Then
	StrParseText = strRawText
	Exit Function
End If
strText=Replace(strRawText,"¶",vbLf)
If Instr(strText,"{?") > 0 Or Instr(strText,"{¿") > 0 Then
	arrParts = GetLanguageParts(strText)
	strResult = ""
	If fLangShowOthers And (UBound(arrParts) > 3) Then	' swap if needed to put skin language first
		For i=2 To UBound(arrParts) Step 2
			If arrParts(i) <> "" Then Exit For	' stop if not consecutive phrases
			If i < UBound(arrParts) Then
				If Left(arrParts(i+1), Instr(arrParts(i+1),":")-1) = Session("ReportLanguage") Then
					strTemp = arrParts(1)
					arrParts(1) = arrParts(i+1)
					arrParts(i+1) = strTemp
				End If
			End If
		Next
	End If
	For i=0 To UBound(arrParts) Step 2
		strResult = strResult & arrParts(i)
		If i < UBound(arrParts) Then
			If Instr(arrParts(i+1),":") < 3 Then
				Report.LogError Util.FormatString(ConfigMessage("ErrorLangMarkup"), strText)
				Exit Function
			Else
				arrSubParts = Split(arrParts(i+1),":")
				If arrSubParts(0) = Session("ReportLanguage") Then
					strResult = strResult & Mid(arrParts(i+1), 2+Len(arrSubParts(0)))
				ElseIf Session("LangShowOthers") Then
					strLang = CustomTag(Null, "_" & arrSubParts(0))
					If strLang = "" Then strLang = arrSubParts(0)
					strResult=strResult & " (<?html?><span class='langtoggle' onclick=""javascript:this.nextSibling.style.display = (this.nextSibling.style.display == 'none' ? 'inline' : 'none');"">" & strLang & "</span><span style='display:none' onclick=""javascript:this.style.display = (this.style.display == 'none' ? 'inline' : 'none');"">: " & Util.HtmlEncode( Mid(arrParts(i+1), 2+Len(arrSubParts(0)))) & "</span><?text?>) "
				End If
			End If
		End If
	Next
	If strResult = "" And Session("LangShowDefault") <> "" Then
		For i=0 To UBound(arrParts) Step 2
			If i < UBound(arrParts) Then
				strResult = strResult & arrParts(i)
				arrSubParts = Split(arrParts(i+1),":")
				If arrSubParts(0) = Session("LangShowDefault") Then strResult = strResult & Mid(arrParts(i+1), 2+Len(arrSubParts(0)))
			End If
		Next
	End If
	StrParseText = strResult
Else
	StrParseText = strText
End If
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function StrPlainText(obj, strRawText)
'==================================
	' check for language specific sections, making skin language sections visible by default
	Dim arrParts, arrSubParts, strResult, i, strLang, strText
	strText=Replace(strRawText,"¶",vbLf)

	If Instr(strText,"{?") > 0 Or Instr(strText,"{¿") > 0 Then
		arrParts = GetLanguageParts(strText)
		strResult = ""
		If Session("LangShowOthers") And (UBound(arrParts) > 3) Then	' swap if needed to put skin language first
			For i=2 To UBound(arrParts) Step 2
				If arrParts(i) <> "" Then Exit For	' stop if not consecutive phrases
				If i < UBound(arrParts) Then
					If Left(arrParts(i+1), Instr(arrParts(i+1),":")-1) = Session("ReportLanguage") Then
						strTemp = arrParts(1)
						arrParts(1) = arrParts(i+1)
						arrParts(i+1) = strTemp
					End If
				End If
			Next
		End If
		For i=0 To UBound(arrParts) Step 2
			strResult = strResult & arrParts(i)
			If i < UBound(arrParts) Then
				If Instr(arrParts(i+1),":") < 3 Then
					Report.LogError Util.FormatString(ConfigMessage("ErrorLangMarkup"), strText)
					Exit Function
				Else
					arrSubParts = Split(arrParts(i+1),":")
					If arrSubParts(0) = Session("ReportLanguage") Then
						strResult = strResult & Mid(arrParts(i+1), 2+Len(arrSubParts(0)))
					ElseIf Session("LangShowOthers") Then
						strLang = CustomTag(Null, "_" & arrSubParts(0))
						If strLang = "" Then strLang = arrSubParts(0)
						strResult=strResult & " (" & strLang & ": " & Mid(arrParts(i+1), 2+Len(arrSubParts(0))) & ") "
					End If
				End If
			End If
		Next
		If strResult = "" And Session("LangShowDefault") <> "" Then
			For i=0 To UBound(arrParts) Step 2
				If i < UBound(arrParts) Then
					strResult = strResult & arrParts(i)
					arrSubParts = Split(arrParts(i+1),":")
					If arrSubParts(0) = Session("LangShowDefault") Then strResult = strResult & Mid(arrParts(i+1), 2+Len(arrSubParts(0)))
				End If
			Next
		End If
	Else
		StrResult = strText
	End If
	'
	' Remove text 'processing instructions' embedded in Comment, Descriptions, Custom Tags etc.
	'
	Dim strPart, strParts, strSubParts, strParams, strUID, strMode, strTemp
	If strResult = "" or strResult = "<?text?>" Then
		StrPlainText = ""
		Exit Function
	End If
	strMode = "<?text?>"
	strParts = split(StrParseText(strResult, True), "<?")
	strSubParts = split(strParts(0),Dic("Private"))
	strResult = Util.FormatString("{&x}",strSubParts(0))		' get any leading text less any old format private section
	For i=1 to Ubound(strParts)
		strSubParts = split(strParts(i), "?>")
		If Ubound(strSubParts) <> 1 Then Report.LogError Util.FormatString(ConfigMessage("ErrorTextFormat"), obj, strText)
		strParams = split(strSubParts(0), " ")
		Select Case LCase(strParams(0))
			Case "text"
				strResult = strResult & Util.FormatString("{&x}",strSubParts(1))
				strMode = "<?" & strSubParts(0) & "?>"
		End Select
	Next
	StrPlainText = strResult

End Function

Function StrPlainName(strName)
	StrPlainName = Replace(strName, Session("MarkerFirstName"), "")
End Function

Function StrNewUID()
'===================
	g_UID = g_UID + 1
	StrNewUID = g_UID & ""
End Function

Function CustomTag(obj,tag)
'==========================
On Error Resume Next
If Not IsNull(obj) Then		' ordinary custom tag
	CustomTag = obj.TagValue(tag)
Else				' Document custom Tag
	CustomTag = Session("oGlobal").selectSingleNode(tag).text
End If
End Function

Function GetDate(oDate)
'======================
' format date for sorting
  Dim Year, NYear
	If Not Util.IsNothing(oDate) Then
  	 Year = CustomDate(oDate).Year
  	 NYear = Right("0000" & CustomDate(oDate).NYear, 4)
     GetDate = Util.FormatPhrase(Dic("FmtDateSort"), Util.IfElse(Right(Year,2)="BC","-","+") & NYear, Util.IfElse(oDate.Month<>"",Right("0" & oDate.Month,2),"00"), Util.IfElse(oDate.Day<>"",Right("0" & oDate.Day,2),"00"))
  Else
     GetDate = "+0000"
  End If
End Function

Function GetDateString(oDate)
	If Not Util.IsNothing(oDate) Then
         GetDateString = CustomDate(oDate).ToString("")
  Else
         GetDateString = ""
  End If
End Function

Function GetLanguageParts(strText)
'=================================
' Break a Multiple Language formatted field into an array its component parts
	Dim oMatches, oRegExp, i
	Set oRegExp = New RegExp
	If  Instr(strText,"{¿") > 0 Then			' type 1 Multiple Language Format
		oRegExp.Global = True
		oRegExp.Pattern = "\{¿[A-Z]{2}:([^¿]|¿[^\}])*¿\}"
		Set oMatches = oRegExp.Execute(strText)
		i = oMatches.Count
		oRegExp.Pattern="\{¿"
		Set oMatches = oRegExp.Execute(strText)
		If i <> oMatches.Count Then Report.LogError Util.FormatString(ConfigMessage("ErrorLangMarkup"), strText)
		oRegExp.Pattern="¿\}"
		Set oMatches = oRegExp.Execute(strText)
		If i <> oMatches.Count Then Report.LogError Util.FormatString(ConfigMessage("ErrorLangMarkup"), strText)
		GetLanguageParts = split(Replace(strText,"¿}","{¿"),"{¿")
	Else							' type 2 Multiple Language Format
		oRegExp.Global = True
		oRegExp.Pattern = "\{\?[A-Z]{2}:[^\}]*\}"
		Set oMatches = oRegExp.Execute(strText)
		i = oMatches.Count
		oRegExp.Pattern="\{\?"
		Set oMatches = oRegExp.Execute(strText)
		If i <> oMatches.Count Then Report.LogError Util.FormatString(ConfigMessage("ErrorLangMarkup"), strText)
		oRegExp.Pattern="\}"
		Set oMatches = oRegExp.Execute(strText)
		If i <> oMatches.Count Then Report.LogError Util.FormatString(ConfigMessage("ErrorLangMarkup"), strText)
		GetLanguageParts = split(Replace(strText,"}","{?"),"{?")
	End If
End Function

Function MatchDate(o, p, obj)
'============================
	If o.Id = p.ID And obj.ToStringNarrative <> "" Then
		Set MatchDate = obj
	Else
		Set MatchDate = Nothing
	End If
End Function

Function PicResize(p, strNewPath, nMaxWidth, nMaxHeight, fFixRatio, fForce)
	Dim strOldPath, nWidth, hHeight, nDPI, nRatioPic, nRatioLab, nErrorCode, strDim
	strOldPath = p.Path
	PicResize = ""
	If Not Util.IsNothing(p.Cache.DPI) Then
		strDim = PicRedim(p, nMaxWidth, nMaxHeight, fFixRatio, fForce)
		nHeight = Util.GetHeight(strDim) + 0
		nWidth = Util.GetWidth(strDim) + 0
		nDPI = p.Cache.DPI
		If Not IsNumeric(nDPI) Then nDPI = 0
		If nDPI = 0 Or nDPI > Session("ThumbnailDpi") Then nDPI = Session("ThumbnailDpi")
		If LCase(Left(p.Path,5)) = "http:" Then
			Err.Clear
			'Report.LogComment "Fetching " & strOldPath
			On Error Resume Next
			oHttp.Open "Get", strOldPath, False
			oHttp.Send
			If Err.Number <> 0 Then
				Report.LogError Util.FormatString(ConfigMessage("ErrorHttpGet"),(Err.Number And (256*256-1)), Err.Description, strOldPath)
				Exit Function
			End If
			oBinaryStream.Write oHttp.ResponseBody
			oBinaryStream.SaveToFile strNewPath, 2
			strOldPath = strNewPath
		End If
		nErrorCode = oShell.Run("""" & Session("IrfanViewPath") & """ """ & strOldPath & """ /resize=(" & nWidth & "," & nHeight & ") /resample /dpi=(" & nDPI & "," & nDPI & ")" & Util.IfElse(fFixRatio, " /aspectratio", "") & " /jpgq=" & Session("ThumbnailQuality") & " /convert=""" & strNewPath & """", 0, True)
		if nErrorCode <> 0 Then
			Report.LogWarning Util.FormatString(ConfigMessage("ErrorPictureConvert"), nErrorCode, p.Path, strNewPath)
		Else
			PicResize = nWidth & "x" & nHeight
		End If
	Else
		Report.LogError Util.FormatString(ConfigMessage("ErrorNoCachedSize"), strOldPath)
	End If
	g_PicPath = strOldPath
End Function

Function PicRedim(p,nMaxWidth, nMaxHeight, fFixRatio,fForce)
	Dim nHeight, nWidth, nRationPic, nRatioLab
	nHeight = Util.GetHeight(strDim) + 0
	nWidth = Util.GetWidth(p.Cache.Dimension) + 0
	nHeight = Util.GetHeight(p.Cache.Dimension) + 0
	If fForce Or nWidth > nMaxWidth Or nHeight > nMaxHeight Then
		nRatioPic = nWidth / nHeight
		nRatioLab = nMaxWidth / nMaxHeight
		nWidth=nMaxWidth
		nHeight=nMaxHeight
		If fFixRatio = True Then
			If nRatioLab > nRatioPic Then	' wider
				nHeight = nMaxHeight
				nWidth = Round(nHeight * nRatioPic, 0)
			Else
				nWidth = nMaxWidth
				nHeight = Round(nWidth / nRatioPic, 0)
			End If
		End If
	End If
	PicRedim = nWidth & "x" & nHeight
End Function

Function CustomDate(oDate)
' Check date for text only date e.g. 400 BC
' If true return a CustomDate object else return gnoDate object
         Dim DateObject
         Set DateObject = New CustomDateClass
         If Not DateObject.Test(oDate) Then
            Set CustomDate = oDate                   ' standard GenoPro Date
         Else
             DateObject.Parse oDate
             Set CustomDate = DateObject
         End If
End Function

Class CustomDateClass
      Private oDate_, Approximation_, Year_, NYear_, Era_, Value_
      Private BCDate, oMatches, oMatch

      Private Sub Class_Initialize()
         Set BCDate = New RegExp
         BCDate.IgnoreCase = True
         BCDate.Pattern = "(|~|<|>)(\d+) (BC)"
      End Sub

      Public Function Test(oDate)
         Test = BCDate.Test(oDate)
      End Function

      Public Sub Parse(oDate)
        Set oDate_ = oDate
        Value_ = oDate
        Set oMatches = BCDate.Execute(oDate_)
        Set oMatch = oMatches(0)
        Approximation_ = oMatch.SubMatches(0)
        Era_ = oMatch.SubMatches(2)
        Year_ = oMatch.SubMatches(1)
      End Sub

      Public Default Property Get Value
        Value=Value_
      End Property
      Public Property Get Approximation
        Approximation=Approximation_
      End Property
      Public Property Get Year
        Year=Year_ & " " & Era_
      End Property
      Public Property Get Era
        Era=Era_
      End Property
      Public Property Get NYear
        NYear=Int("0" & Year_)
      End Property
      Public Property Get NMonth
        NMonth=0
      End Property
      Public Property Get NDay
        NDay=0
      End Property
      Public Property Get ToStringNarrative
        ToStringNarrative=DateFormat(GetDateFormat("Narrative", "YG"))
      End Property
      Public Function ToString(fmt)
        ToString=DateFormat(Util.IfElse(fmt<>"",Replace(fmt, "yyyy", "yyyy GG") ,GetDateFormat("Default", "YG")))
      End Function
      Private Function DateFormat(fmt)
        Dim start, fini, preposition, index
        start=Instr(fmt,"[")
        fini=Instr(fmt,"]")
        prepositions = split(Mid(fmt, start+1,fini-start),"|")
        index=0
        If Approximation <> "" Then index=Instr("~<>", Approximation_)
        DateFormat=" " & Trim(Replace(Replace(Left(fmt,start-1) & prepositions(index) & Mid(fmt,fini+1),"yyyy",Year_), "GG", Era_))
      End Function
End Class

Sub GoogleAnalytics()
If Session("GoogleAnalyticsAccount") <> "" Then
   Report.WriteLn "<script type=""text/javascript"">"
   Report.WriteLn "var _gaq = _gaq || [];"
   Report.WriteFormattedLn "_gaq.push(['_setAccount', '{}']);", Session("GoogleAnalyticsAccount")
   If Session("GoogleAnalyticsDomain") <> "" Then
      Report.WriteFormattedLn "_gaq.push(['_setDomainName', '{}']);", Session("GoogleAnalyticsDomain")
   End If
   Report.WriteLn "_gaq.push(['_trackPageview']);"
   Report.WriteLn "(function () {"
   Report.WriteLn "    var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;"
   Report.WriteLn "    ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';"
   Report.WriteLn "    var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);"
   Report.WriteLn "})();"
   Report.WriteLn "</script>"
End If
End Sub

Sub CurvyBoxOpen()
	Report.WriteLn "<div class='curvyboxbackground'>"
	Report.WriteLn " <div class='curvycorners_box'>"
	Report.WriteLn "  <div class='curvycorners_top'><div></div></div>"
	Report.WriteLn "   <div class='curvycorners_content'>"
End Sub

Sub CurvyBoxClose()
	Report.WriteLn "   </div>"
	Report.WriteLn "  <div class='curvycorners_bottom'><div></div></div>"
	Report.WriteLn " </div>"
	Report.WriteLn "</div>"
End Sub


